home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Internet Tools 1993 July / Internet Tools.iso / RockRidge / archival / mirror-2.1 / ftp.pl < prev    next >
Encoding:
Perl Script  |  1993-06-28  |  23.4 KB  |  1,256 lines

  1. #-*-perl-*-
  2. # This is a wrapper to the chat2.pl routines that make life easier
  3. # to do ftp type work.
  4. # Mostly by Lee McLoughlin <lmjm@doc.ic.ac.uk>
  5. # based on original version by Alan R. Martello <al@ee.pitt.edu>
  6. # And by A.Macpherson@bnr.co.uk for multi-homed hosts
  7. #
  8. # Basic usage:
  9. #  $ftp_port = 21;
  10. #  $retry_call = 1;
  11. #  $attempts = 2;
  12. #  if( &ftp'open( $site, $ftp_port, $retry_call, $attempts ) != 1 ){
  13. #   die "failed to open ftp connection";
  14. #  }
  15. #  if( ! &ftp'login( $user, $pass ) ){
  16. #   die "failed to login";
  17. #  }
  18. #  &ftp'type( $text_mode ? 'A' : 'I' );
  19. #  if( ! &ftp'get( $remote_filename, $local_filename, 0 ) ){
  20. #   die "failed to get file;
  21. #  }
  22. #  &ftp'quit();
  23. #
  24. #
  25. # $Id: ftp.pl,v 2.1 1993/06/28 15:02:00 lmjm Exp lmjm $
  26. # $Log: ftp.pl,v $
  27. # Revision 2.1  1993/06/28  15:02:00  lmjm
  28. # Full 2.1 release
  29. #
  30. #
  31.  
  32. require 'chat2.pl';
  33. require 'socket.ph';
  34.  
  35.  
  36. package ftp;
  37.  
  38. if( defined( &main'PF_INET ) ){
  39.     $pf_inet = &main'PF_INET;
  40.     $sock_stream = &main'SOCK_STREAM;
  41.     local($name, $aliases, $proto) = getprotobyname( 'tcp' );
  42.     $tcp_proto = $proto;
  43. }
  44. else {
  45.     # XXX hardwired $PF_INET, $SOCK_STREAM, 'tcp'
  46.     # but who the heck would change these anyway? (:-)
  47.     $pf_inet = 2;
  48.     $sock_stream = 1;
  49.     $tcp_proto = 6;
  50. }
  51.  
  52. # If the remote ftp daemon doesn't respond within this time presume its dead
  53. # or something.
  54. $timeout = 120;
  55.  
  56. # Timeout a read if I don't get data back within this many seconds
  57. $timeout_read = 3 * $timeout;
  58.  
  59. # Timeout an open
  60. $timeout_open = $timeout;
  61.  
  62. $ftp'version = '$Revision: 2.1 $';
  63.  
  64. # This is a "global" it contains the last response from the remote ftp server
  65. # for use in error messages
  66. $ftp'response = "";
  67. # Also ftp'NS is the socket containing the data coming in from the remote ls
  68. # command.
  69.  
  70. # The size of block to be read or written when talking to the remote
  71. # ftp server
  72. $ftp'ftpbufsize = 4096;
  73.  
  74. # How often to print a hash out, when debugging
  75. $ftp'hashevery = 1024;
  76. # Output a newline after this many hashes to prevent outputing very long lines
  77. $ftp'hashnl = 70;
  78.  
  79. # Is there a connection open?
  80. $ftp'service_open = 0;
  81.  
  82. # If a proxy connection then who am I really talking to?
  83. $real_site = "";
  84.  
  85. # Where error/log reports are sent to
  86. $ftp'showfd = 'STDERR';
  87.  
  88. # Name of a function to call on a pathname to map it into a remote
  89. # pathname.
  90. $ftp'mapunixout = '';
  91. $ftp'manunixin = '';
  92.  
  93. # This is just a tracing aid.
  94. $ftp_show = 0;
  95.  
  96. sub ftp'debug
  97. {
  98.     $ftp_show = @_[0];
  99.     if( $ftp_show > 9 ){
  100.         $chat'debug = 1;
  101.     }
  102. }
  103.  
  104. sub ftp'set_timeout
  105. {
  106.     local( $to ) = @_;
  107.     return if $to == $timeout;
  108.     $timeout = $to;
  109.     $timeout_open = $timeout;
  110.     $timeout_read = 3 * $timeout;
  111.     if( $ftp_show ){
  112.         print $ftp'showfd "ftp timeout set to $timeout\n";
  113.     }
  114. }
  115.  
  116.  
  117. sub ftp'open_alarm
  118. {
  119.     die "timeout: open";
  120. }
  121.  
  122. sub ftp'timed_open
  123. {
  124.     local( $site, $ftp_port, $retry_call, $attempts ) = @_;
  125.     local( $connect_site, $connect_port );
  126.     local( $res );
  127.  
  128.     alarm( $timeout_open );
  129.  
  130.     while( $attempts-- ){
  131.         if( $ftp_show ){
  132.             print $ftp'showfd "proxy connecting via $proxy_gateway [$proxy_ftp_port]\n" if $proxy;
  133.             print $ftp'showfd "Connecting to $site";
  134.             if( $ftp_port != 21 ){
  135.                 print $ftp'showfd " [port $ftp_port]";
  136.             }
  137.             print $ftp'showfd "\n";
  138.         }
  139.         
  140.         if( $proxy ) {
  141.             if( ! $proxy_gateway ) {
  142.                 # if not otherwise set
  143.                 $proxy_gateway = "internet-gateway";
  144.             }
  145.             if( $debug ) {
  146.                 print $ftp'showfd "using proxy services of $proxy_gateway, ";
  147.                 print $ftp'showfd "at $proxy_ftp_port\n";
  148.             }
  149.             $connect_site = $proxy_gateway;
  150.             $connect_port = $proxy_ftp_port;
  151.             $real_site = $site;
  152.         }
  153.         else {
  154.             $connect_site = $site;
  155.             $connect_port = $ftp_port;
  156.         }
  157.         if( ! &chat'open_port( $connect_site, $connect_port ) ){
  158.             if( $retry_call ){
  159.                 print $ftp'showfd "Failed to connect\n" if $ftp_show;
  160.                 next;
  161.             }
  162.             else {
  163.                 print $ftp'showfd "proxy connection failed " if $proxy;
  164.                 print $ftp'showfd "Cannot open ftp to $connect_site\n" if $ftp_show;
  165.                 return 0;
  166.             }
  167.         }
  168.         $res = &ftp'expect( $timeout,
  169.             120, 0, # service unavailable to $site
  170.             220, 1, # ready for login to $site
  171.             421, 0); #service unavailable to $site closing connection
  172.         if( ! $res ){
  173.             &chat'close();
  174.             next;
  175.         }
  176.         return 1;
  177.     }
  178.     continue {
  179.         print $ftp'showfd "Pausing between retries\n";
  180.         sleep( $retry_pause );
  181.     }
  182.     return 0;
  183. }
  184.  
  185. sub main'ftp__sighandler
  186. {
  187.     local( $sig ) = @_;
  188.     local( $msg ) = "Caught a SIG$sig flagging connection down";
  189.     $ftp'service_open = 0;
  190.     if( $ftp_logger ){
  191.         eval "&$ftp_logger( \$msg )";
  192.     }
  193. }
  194.  
  195. sub ftp'set_signals
  196. {
  197.     $ftp_logger = @_;
  198.     $SIG{ 'PIPE' } = "ftp__sighandler";
  199. }
  200.  
  201. # Set the mapunixout and mapunixin functions
  202. sub ftp'set_namemap
  203. {
  204.     ($ftp'mapunixout, $ftp'mapunixin) = @_;
  205.     if( $debug ) {
  206.         print $ftp'showfd "mapunixout = $ftp'mapunixout, $mapunixin = $ftp'mapunixin\n";
  207.     }
  208. }
  209.  
  210.  
  211. sub ftp'open
  212. {
  213.     local( $site, $ftp_port, $retry_call, $attempts ) = @_;
  214.  
  215.     local( $old_sig ) = $SIG{ 'ALRM' };
  216.     $SIG{ 'ALRM' } = "ftp\'open_alarm";
  217.  
  218.     local( $ret ) = eval "&timed_open( '$site', $ftp_port, $retry_call, $attempts )";
  219.     alarm( 0 );
  220.     $SIG{ 'ALRM' } = $old_sig;
  221.  
  222.     if( $@ =~ /^timeout/ ){
  223.         return -1;
  224.     }
  225.  
  226.     if( $ret ){
  227.         $ftp'service_open = 1;
  228.     }
  229.  
  230.     return $ret;
  231. }
  232.  
  233. sub ftp'login
  234. {
  235.     local( $remote_user, $remote_password ) = @_;
  236.         local( $ret );
  237.  
  238.     if( ! $ftp'service_open ){
  239.         return 0;
  240.     }
  241.  
  242.     if( $proxy ){
  243.         &ftp'send( "USER $remote_user@$site" );
  244.     }
  245.     else {
  246.         &ftp'send( "USER $remote_user" );
  247.     }
  248.     $ret = &ftp'expect( $timeout,
  249.         230, 1, # $remote_user logged in
  250.         331, 2, # send password for $remote_user
  251.  
  252.         500, 0, # syntax error
  253.         501, 0, # syntax error
  254.         530, 0, # not logged in
  255.         332, 0, # account for login not supported
  256.  
  257.         421, 99 ); # service unavailable, closing connection
  258.     if( $ret == 99 ){
  259.         &service_closed();
  260.         $ret = 0;
  261.     }
  262.     if( $ret == 1 ){
  263.         # Logged in no password needed
  264.         return 1;
  265.     }
  266.     elsif( $ret == 2 ){
  267.         # A password is needed
  268.         &ftp'send( "PASS $remote_password" );
  269.  
  270.         $ret = &ftp'expect( $timeout,
  271.             230, 1, # $remote_user logged in
  272.  
  273.             202, 0, # command not implemented
  274.             332, 0, # account for login not supported
  275.  
  276.             530, 0, # not logged in
  277.             500, 0, # syntax error
  278.             501, 0, # syntax error
  279.             503, 0,  # bad sequence of commands
  280.  
  281.             421, 99 ); # service unavailable, closing connection
  282.         if( $ret == 99 ){
  283.             &service_closed();
  284.             $ret = 0;
  285.         }
  286.         if( $ret == 1 ){
  287.             # Logged in
  288.             return 1;
  289.         }
  290.     }
  291.     # If I got here I failed to login
  292.     return 0;
  293. }
  294.  
  295. sub service_closed
  296. {
  297.     $ftp'service_open = 0;
  298.     &chat'close();
  299. }
  300.  
  301. sub ftp'close
  302. {
  303.     &ftp'quit();
  304.     $ftp'service_open = 0;
  305.     &chat'close();
  306. }
  307.  
  308. # Change directory
  309. # return 1 if successful
  310. # 0 on a failure
  311. sub ftp'cwd
  312. {
  313.     local( $dir ) = @_;
  314.     local( $ret );
  315.  
  316.     if( ! $ftp'service_open ){
  317.         return 0;
  318.     }
  319.  
  320.     if( $ftp'mapunixout ){
  321.         $dir = eval "&$ftp'mapunixout( \$dir, 'd' )";
  322.     }
  323.  
  324.     &ftp'send( "CWD $dir" );
  325.  
  326.     $ret = &ftp'expect( $timeout,
  327.         200, 1, # working directory = $dir
  328.         250, 1, # working directory = $dir
  329.  
  330.         500, 0, # syntax error
  331.         501, 0, # syntax error
  332.                 502, 0, # command not implemented
  333.         530, 0, # not logged in
  334.                 550, 0, # cannot change directory
  335.         421, 99 ); # service unavailable, closing connection
  336.  
  337.     if( $ret == 99 ){
  338.         &service_closed();
  339.         $ret = 0;
  340.     }
  341.  
  342.     return $ret;
  343. }
  344.  
  345. # Get a full directory listing:
  346. # &ftp'dir( remote LIST options )
  347. # Start a list going with the given options.
  348. # Presuming that the remote deamon uses the ls command to generate the
  349. # data to send back then then you can send it some extra options (eg: -lRa)
  350. # return 1 if sucessful and 0 on a failure
  351. sub ftp'dir_open
  352. {
  353.     local( $options ) = @_;
  354.     local( $ret );
  355.     
  356.     if( ! $ftp'service_open ){
  357.         return 0;
  358.     }
  359.  
  360.     if( ! &ftp'open_data_socket() ){
  361.         return 0;
  362.     }
  363.     
  364.     if( $options ){
  365.         &ftp'send( "LIST $options" );
  366.     }
  367.     else {
  368.         &ftp'send( "LIST" );
  369.     }
  370.     
  371.     $ret = &ftp'expect( $timeout,
  372.         150, 1, # reading directory
  373.     
  374.         125, 0, # data connection already open?
  375.     
  376.         450, 0, # file unavailable
  377.         500, 0, # syntax error
  378.         501, 0, # syntax error
  379.         502, 0, # command not implemented
  380.         530, 0, # not logged in
  381.     
  382.             421, 99 ); # service unavailable, closing connection
  383.     if( $ret == 99 ){
  384.         &service_closed();
  385.         $ret = 0;
  386.     }
  387.  
  388.     if( ! $ret ){
  389.         &ftp'close_data_socket;
  390.         return 0;
  391.     }
  392.     
  393.     accept( NS, S ) || die "accept failed $!";
  394.  
  395.     # 
  396.     # the data should be coming at us now
  397.     #
  398.     
  399.     return 1;
  400. }
  401.  
  402.  
  403. # Close down reading the result of a remote ls command
  404. # return 1 if successful and 0 on failure
  405. sub ftp'dir_close
  406. {
  407.     local( $ret );
  408.  
  409.     if( ! $ftp'service_open ){
  410.         return 0;
  411.     }
  412.  
  413.     # read the close
  414.     #
  415.     $ret = &ftp'expect($timeout,
  416.             226, 1, # transfer complete, closing connection
  417.             250, 1, # action completed
  418.  
  419.             425, 0, # can't open data connection
  420.             426, 0, # connection closed, transfer aborted
  421.             451, 0, # action aborted, local error
  422.             421, 99 ); # service unavailable, closing connection
  423.     if( $ret == 99 ){
  424.         &service_closed();
  425.         $ret = 0;
  426.     }
  427.  
  428.     # shut down our end of the socket
  429.     &ftp'close_data_socket;
  430.  
  431.     if( ! $ret ){
  432.         return 0;
  433.     }
  434.  
  435.     return 1;
  436. }
  437.  
  438. # Quit from the remote ftp server
  439. # return 1 if successful and 0 on failure
  440. sub ftp'quit
  441. {
  442.     local( $ret );
  443.  
  444.     $site_command_check = 0;
  445.     @site_command_list = ();
  446.  
  447.     if( ! $ftp'service_open ){
  448.         return 0;
  449.     }
  450.  
  451.     &ftp'send( "QUIT" );
  452.  
  453.     $ret = &ftp'expect( $timeout, 
  454.         221, 1, # transfer complete, closing connection
  455.         500, 0, # error quitting??
  456.         421, 99 ); # service unavailable, closing connection
  457.     if( $ret == 99 ){
  458.         &service_closed();
  459.         $ret = 0;
  460.     }
  461.     return $ret;
  462. }
  463.  
  464. sub ftp'read_alarm
  465. {
  466.     die "timeout: read";
  467. }
  468.  
  469. sub ftp'timed_read
  470. {
  471.     alarm( $timeout_read );
  472.  
  473.     return sysread( NS, $ftpbuf, $ftpbufsize );
  474. }
  475.  
  476. sub ftp'read
  477. {
  478.     $SIG{ 'ALRM' } = "ftp\'read_alarm";
  479.  
  480.     if( ! $ftp'service_open ){
  481.         return -1;
  482.     }
  483.  
  484.     local( $ret ) = eval '&timed_read()';
  485.     alarm( 0 );
  486.  
  487.     if( $@ =~ /^timeout/ ){
  488.         return -1;
  489.     }
  490.     return $ret;
  491. }
  492.  
  493. # Get a remote file back into a local file.
  494. # If no loc_fname passed then uses rem_fname.
  495. # returns 1 on success and 0 on failure
  496. sub ftp'get
  497. {
  498.     local($rem_fname, $loc_fname, $restart ) = @_;
  499.     local( $ret );
  500.     
  501.     if( ! $ftp'service_open ){
  502.         return 0;
  503.     }
  504.  
  505.     if( $loc_fname eq "" ){
  506.         $loc_fname = $rem_fname;
  507.     }
  508.     
  509.     if( ! &ftp'open_data_socket() ){
  510.         print $ftp'showfd "Cannot open data socket\n";
  511.         return 0;
  512.     }
  513.  
  514.     if( $loc_fname ne '-' ){
  515.         # Find the size of the target file
  516.         local( $restart_at ) = &ftp'filesize( $loc_fname );
  517.         if( $restart && $restart_at > 0 && &ftp'restart( $restart_at ) ){
  518.             $restart = 1;
  519.             # Make sure the file can be updated
  520.             chmod( 0644, $loc_fname );
  521.         }
  522.         else {
  523.             $restart = 0;
  524.             unlink( $loc_fname );
  525.         }
  526.     }
  527.  
  528.     if( $ftp'mapunixout ){
  529.         $rem_fname = eval "&$ftp'mapunixout( \$rem_fname, 'f' )";
  530.     }
  531.  
  532.     &ftp'send( "RETR $rem_fname" );
  533.     
  534.     $ret = &ftp'expect( $timeout, 
  535.         150, 1, # receiving $rem_fname
  536.  
  537.         125, 0, # data connection already open?
  538.         450, 2, # file unavailable
  539.         550, 2, # file unavailable
  540.         500, 0, # syntax error
  541.         501, 0, # syntax error
  542.         530, 0, # not logged in
  543.  
  544.         421, 99 ); # service unavailable, closing connection
  545.     if( $ret == 99 ){
  546.         &service_closed();
  547.         $ret = 0;
  548.     }
  549.     if( $ret != 1 ){
  550.         print $ftp'showfd "Failure on 'RETR $rem_fname' command\n";
  551.  
  552.         # shut down our end of the socket
  553.         &ftp'close_data_socket;
  554.  
  555.         return 0;
  556.     }
  557.  
  558.     accept( NS, S ) || die "accept failed $!";
  559.  
  560.     # 
  561.     # the data should be coming at us now
  562.     #
  563.  
  564.     #
  565.     #  open the local fname
  566.     #  concatenate on the end if restarting, else just overwrite
  567.     if( !open( FH, ($restart ? '>>' : '>') . $loc_fname ) ){
  568.         print $ftp'showfd "Cannot create local file $loc_fname\n";
  569.  
  570.         # shut down our end of the socket
  571.         &ftp'close_data_socket;
  572.  
  573.         return 0;
  574.     }
  575.  
  576.     local( $start_time ) = time;
  577.     local( $bytes, $lasthash, $hashes ) = (0, 0, 0);
  578.     while( ($len = &ftp'read()) > 0 ){
  579.         $bytes += $len;
  580.         if( $strip_cr ){
  581.             $ftp'buf =~ s/\r//g;
  582.         }
  583.         if( $ftp_show ){
  584.             while( $bytes > ($lasthash + $ftp'hashevery) ){
  585.                 print $ftp'showfd '#';
  586.                 $lasthash += $ftp'hashevery;
  587.                 $hashes++;
  588.                 if( ($hashes % $ftp'hashnl) == 0 ){
  589.                     print $ftp'showfd "\n";
  590.                 }
  591.             }
  592.         }
  593.         if( ! print FH $ftp'ftpbuf ){
  594.             print $ftp'showfd "\nfailed to write data";
  595.             $bytes = -1;
  596.             last;
  597.         }
  598.     }
  599.     close( FH );
  600.  
  601.     # shut down our end of the socket
  602.     &ftp'close_data_socket;
  603.  
  604.     if( $len < 0 ){
  605.         print $ftp'showfd "\ntimed out reading data!\n";
  606.  
  607.         return 0;
  608.     }
  609.         
  610.     if( $ftp_show && $bytes > 0 ){
  611.         if( $hashes && ($hashes % $ftp'hashnl) != 0 ){
  612.             print $ftp'showfd "\n";
  613.         }
  614.         local( $secs ) = (time - $start_time);
  615.         if( $secs <= 0 ){
  616.             $secs = 1; # To avoid a divide by zero;
  617.         }
  618.  
  619.         local( $rate ) = int( $bytes / $secs );
  620.         print $ftp'showfd "Got $bytes bytes ($rate bytes/sec)\n";
  621.     }
  622.  
  623.     #
  624.     # read the close
  625.     #
  626.  
  627.     $ret = &ftp'expect( $timeout, 
  628.         226, 1, # transfer complete, closing connection
  629.             250, 1, # action completed
  630.     
  631.             110, 0, # restart not supported
  632.             425, 0, # can't open data connection
  633.             426, 0, # connection closed, transfer aborted
  634.             451, 0, # action aborted, local error
  635.         550, 0, # permission denied
  636.  
  637.         421, 99 ); # service unavailable, closing connection
  638.     if( $ret == 99 ){
  639.         &service_closed();
  640.         $ret = 0;
  641.     }
  642.  
  643.     if( $ret && $bytes < 0 ){
  644.         $ret = 0;
  645.     }
  646.  
  647.     return $ret;
  648. }
  649.  
  650. sub ftp'delete
  651. {
  652.     local( $rem_fname ) = @_;
  653.     local( $ret );
  654.  
  655.     if( ! $ftp'service_open ){
  656.         return 0;
  657.     }
  658.  
  659.     if( $ftp'mapunixout ){
  660.         $rem_fname = eval "&$ftp'mapunixout( \$rem_fname, 'f' )";
  661.     }
  662.  
  663.     &ftp'send( "DELE $rem_fname" );
  664.  
  665.     $ret = &ftp'expect( $timeout, 
  666.         250, 1, # Deleted $rem_fname
  667.         550, 0, # Permission denied
  668.  
  669.         421, 99 ); # service unavailable, closing connection
  670.     if( $ret == 99 ){
  671.         &service_closed();
  672.         $ret = 0;
  673.     }
  674.  
  675.     return $ret == 1;
  676. }
  677.  
  678. sub ftp'deldir
  679. {
  680.     local( $fname ) = @_;
  681.  
  682.     # not yet implemented
  683.     # RMD
  684. }
  685.  
  686. # UPDATE ME!!!!!!
  687. # Add in the hash printing and newline conversion
  688. sub ftp'put
  689. {
  690.     local( $loc_fname, $rem_fname ) = @_;
  691.     local( $strip_cr );
  692.     
  693.     if( ! $ftp'service_open ){
  694.         return 0;
  695.     }
  696.  
  697.     if( $loc_fname eq "" ){
  698.         $loc_fname = $rem_fname;
  699.     }
  700.     
  701.     if( ! &ftp'open_data_socket() ){
  702.         return 0;
  703.     }
  704.     
  705.     if( $ftp'mapunixout ){
  706.         $rem_fname = eval "&$ftp'mapunixout( \$rem_fname, 'f' )";
  707.     }
  708.  
  709.     &ftp'send( "STOR $rem_fname" );
  710.     
  711.     # 
  712.     # the data should be coming at us now
  713.     #
  714.     
  715.     local( $ret ) =
  716.     &ftp'expect( $timeout, 
  717.         150, 1, # sending $loc_fname
  718.  
  719.         125, 0, # data connection already open?
  720.         450, 0, # file unavailable
  721.         532, 0, # need account for storing files
  722.         452, 0, # insufficient storage on system
  723.         553, 0, # file name not allowed
  724.         500, 0, # syntax error
  725.         501, 0, # syntax error
  726.         530, 0, # not logged in
  727.  
  728.         421, 99 ); # service unavailable, closing connection
  729.     if( $ret == 99 ){
  730.         &service_closed();
  731.         $ret = 0;
  732.     }
  733.  
  734.     if( $ret != 1 ){
  735.         # shut down our end of the socket
  736.         &ftp'close_data_socket;
  737.  
  738.         return 0;
  739.     }
  740.  
  741.  
  742.     accept( NS, S ) || die "accept failed $!";
  743.  
  744.     # 
  745.     # the data should be coming at us now
  746.     #
  747.     
  748.     #
  749.     #  open the local fname
  750.     #
  751.     if( !open( FH, "<$loc_fname" ) ){
  752.         print $ftp'showfd "Cannot open local file $loc_fname\n";
  753.  
  754.         # shut down our end of the socket
  755.         &ftp'close_data_socket;
  756.  
  757.         return 0;
  758.     }
  759.     
  760.     while( <FH> ){
  761.         if( ! $ftp'service_open ){
  762.             last;
  763.         }
  764.         print NS ;
  765.     }
  766.     close( FH );
  767.     
  768.     # shut down our end of the socket to signal EOF
  769.     &ftp'close_data_socket;
  770.     
  771.     #
  772.     # read the close
  773.     #
  774.     
  775.     $ret = &ftp'expect( $timeout, 
  776.         226, 1, # transfer complete, closing connection
  777.         250, 1, # action completed
  778.     
  779.         110, 0, # restart not supported
  780.         425, 0, # can't open data connection
  781.         426, 0, # connection closed, transfer aborted
  782.         451, 0, # action aborted, local error
  783.         551, 0, # page type unknown
  784.         552, 0, # storage allocation exceeded
  785.     
  786.         421, 99 ); # service unavailable, closing connection
  787.     if( $ret == 99 ){
  788.         &service_closed();
  789.         $ret = 0;
  790.     }
  791.     if( ! $ret ){
  792.         print $ftp'showfd "Failure on 'STOR $loc_fname' command\n";
  793.     }
  794.     return $ret;
  795. }
  796.  
  797. sub ftp'restart
  798. {
  799.     local( $restart_point, $ret ) = @_;
  800.  
  801.     if( ! $ftp'service_open ){
  802.         return 0;
  803.     }
  804.  
  805.     &ftp'send( "REST $restart_point" );
  806.  
  807.     # 
  808.     # see what they say
  809.  
  810.     $ret = &ftp'expect( $timeout, 
  811.         350, 1, # restarting at $restart_point
  812.                
  813.         500, 0, # syntax error
  814.         501, 0, # syntax error
  815.         502, 2, # REST not implemented
  816.         530, 0, # not logged in
  817.         554, 2, # REST not implemented
  818.                
  819.         421, 99 ); # service unavailable, closing connection
  820.     if( $ret == 99 ){
  821.         &service_closed();
  822.         $ret = 0;
  823.     }
  824.     return $ret;
  825. }
  826.  
  827. # Set the file transfer type
  828. sub ftp'type
  829. {
  830.     local( $type ) = @_;
  831.  
  832.     if( ! $ftp'service_open ){
  833.         return 0;
  834.     }
  835.  
  836.     &ftp'send( "TYPE $type" );
  837.  
  838.     # 
  839.     # see what they say
  840.  
  841.     $ret = &ftp'expect( $timeout, 
  842.         200, 1, # file type set to $type
  843.                
  844.         500, 0, # syntax error
  845.         501, 0, # syntax error
  846.         504, 0, # Invalid form or byte size for type $type
  847.                
  848.         421, 99 ); # service unavailable, closing connection
  849.     if( $ret == 99 ){
  850.         &service_closed();
  851.         $ret = 0;
  852.     }
  853.     return $ret;
  854. }
  855.  
  856. $site_command_check = 0;
  857. @site_command_list = ();
  858.  
  859. # routine to query the remote server for 'SITE' commands supported
  860. sub ftp'site_commands
  861. {
  862.     local( $ret );
  863.     
  864.     if( ! $ftp'service_open ){
  865.         return 0;
  866.     }
  867.  
  868.     # if we havent sent a 'HELP SITE', send it now
  869.     if( !$site_command_check ){
  870.     
  871.         $site_command_check = 1;
  872.     
  873.         &ftp'send( "HELP SITE" );
  874.     
  875.         # assume the line in the HELP SITE response with the 'HELP'
  876.         # command is the one for us
  877.         $ret = &ftp'expect( $timeout,
  878.             ".*HELP.*", "\$1",
  879.             214, "0",
  880.             202, "0",
  881.             421, "99" ); # service unavailable, closing connection
  882.         if( $ret == 99 ){
  883.             &service_closed();
  884.             $ret = "0";
  885.         }
  886.     
  887.         if( $ret eq "0" ){
  888.             print $ftp'showfd "No response from HELP SITE\n" if( $ftp_show );
  889.         }
  890.     
  891.         @site_command_list = split(/\s+/, $ret);
  892.     }
  893.     
  894.     return @site_command_list;
  895. }
  896.  
  897. # return the pwd, or null if we can't get the pwd
  898. sub ftp'pwd
  899. {
  900.     local( $ret, $cwd );
  901.  
  902.     if( ! $ftp'service_open ){
  903.         return 0;
  904.     }
  905.  
  906.     &ftp'send( "PWD" );
  907.  
  908.     # 
  909.     # see what they say
  910.  
  911.     $ret = &ftp'expect( $timeout, 
  912.         257, 1, # working dir is
  913.         500, 0, # syntax error
  914.         501, 0, # syntax error
  915.         502, 0, # PWD not implemented
  916.         550, 0, # file unavailable
  917.  
  918.         421, 99 ); # service unavailable, closing connection
  919.     if( $ret == 99 ){
  920.         &service_closed();
  921.         $ret = 0;
  922.     }
  923.     if( $ret ){
  924.         if( $ftp'response =~ /^257\s"(.*)"\s.*$/ ){
  925.             $cwd = $1;
  926.         }
  927.     }
  928.     return $cwd;
  929. }
  930.  
  931. # return 1 for success, 0 for failure
  932. sub ftp'mkdir
  933. {
  934.     local( $path ) = @_;
  935.     local( $ret );
  936.  
  937.     if( ! $ftp'service_open ){
  938.         return 0;
  939.     }
  940.  
  941.     if( $ftp'mapunixout ){
  942.         $path = eval "&$ftp'mapunixout( \$path, 'f' )";
  943.     }
  944.  
  945.     &ftp'send( "MKD $path" );
  946.  
  947.     # 
  948.     # see what they say
  949.  
  950.     $ret = &ftp'expect( $timeout, 
  951.         257, 1, # made directory $path
  952.                
  953.         500, 0, # syntax error
  954.         501, 0, # syntax error
  955.         502, 0, # MKD not implemented
  956.         530, 0, # not logged in
  957.         550, 0, # file unavailable
  958.  
  959.         421, 99 ); # service unavailable, closing connection
  960.     if( $ret == 99 ){
  961.         &service_closed();
  962.         $ret = 0;
  963.     }
  964.     return $ret;
  965. }
  966.  
  967. # return 1 for success, 0 for failure
  968. sub ftp'chmod
  969. {
  970.     local( $path, $mode ) = @_;
  971.     local( $ret );
  972.  
  973.     if( ! $ftp'service_open ){
  974.         return 0;
  975.     }
  976.  
  977.     if( $ftp'mapunixout ){
  978.         $path = eval "&$ftp'mapunixout( \$path, 'f' )";
  979.     }
  980.  
  981.     &ftp'send( sprintf( "SITE CHMOD %o $path", $mode ) );
  982.  
  983.     # 
  984.     # see what they say
  985.  
  986.     $ret = &ftp'expect( $timeout, 
  987.         200, 1, # chmod $mode $path succeeded
  988.                
  989.         500, 0, # syntax error
  990.         501, 0, # syntax error
  991.         502, 0, # CHMOD not implemented
  992.         530, 0, # not logged in
  993.         550, 0, # file unavailable
  994.  
  995.         421, 99 ); # service unavailable, closing connection
  996.     if( $ret == 99 ){
  997.         &service_closed();
  998.         $ret = 0;
  999.     }
  1000.     return $ret;
  1001. }
  1002.  
  1003. # rename a file
  1004. sub ftp'rename
  1005. {
  1006.     local( $old_name, $new_name ) = @_;
  1007.     local( $ret );
  1008.  
  1009.     if( ! $ftp'service_open ){
  1010.         return 0;
  1011.     }
  1012.  
  1013.     if( $ftp'mapunixout ){
  1014.         $old_name = eval "&$ftp'mapunixout( \$old_name, 'f' )";
  1015.     }
  1016.  
  1017.     &ftp'send( "RNFR $old_name" );
  1018.  
  1019.     # 
  1020.     # see what they say
  1021.  
  1022.     $ret = &ftp'expect( $timeout, 
  1023.         350, 1, #  OK
  1024.                
  1025.         500, 0, # syntax error
  1026.         501, 0, # syntax error
  1027.         502, 0, # RNFR not implemented
  1028.         530, 0, # not logged in
  1029.         550, 0, # file unavailable
  1030.         450, 0, # file unavailable
  1031.                
  1032.         421, 99 ); # service unavailable, closing connection
  1033.     if( $ret == 99 ){
  1034.         &service_closed();
  1035.         $ret = 0;
  1036.     }
  1037.  
  1038.     # check if the "rename from" occurred ok
  1039.     if( $ret ){
  1040.         if( $ftp'mapunixout ){
  1041.             $new_name = eval "&$ftp'mapunixout( \$new_name, 'f' )";
  1042.         }
  1043.  
  1044.         &ftp'send( "RNTO $new_name" );
  1045.     
  1046.         # 
  1047.         # see what they say
  1048.     
  1049.         $ret = &ftp'expect( $timeout, 
  1050.             250, 1,  # rename $old_name to $new_name
  1051.  
  1052.             500, 0, # syntax error
  1053.             501, 0, # syntax error
  1054.             502, 0, # RNTO not implemented
  1055.             503, 0, # bad sequence of commands
  1056.             530, 0, # not logged in
  1057.             532, 0, # need account for storing files
  1058.             553, 0, # file name not allowed
  1059.  
  1060.             421, 99 ); # service unavailable, closing connection
  1061.         if( $ret == 99 ){
  1062.             &service_closed();
  1063.             $ret = 0;
  1064.         }
  1065.     }
  1066.  
  1067.     return $ret;
  1068. }
  1069.  
  1070.  
  1071. sub ftp'quote
  1072. {
  1073.     local( $cmd ) = @_;
  1074.     local( $ret );
  1075.  
  1076.     if( ! $ftp'service_open ){
  1077.         return 0;
  1078.     }
  1079.  
  1080.     &ftp'send( $cmd );
  1081.  
  1082.     $ret = &ftp'expect( $timeout, 
  1083.         200, 1, # Remote '$cmd' OK
  1084.         500, 0, # error in remote '$cmd'
  1085.         421, 99 ); # service unavailable, closing connection
  1086.     if( $ret == 99 ){
  1087.         &service_closed();
  1088.         $ret = 0;
  1089.     }
  1090.     return $ret;
  1091. }
  1092.  
  1093. # ------------------------------------------------------------------------------
  1094. # These are the lower level support routines
  1095.  
  1096. sub ftp'expectgot
  1097. {
  1098.     ($ftp'response, $ftp'fatalerror) = @_;
  1099.     if( $ftp_show ){
  1100.         print $ftp'showfd "$ftp'response\n";
  1101.     }
  1102. }
  1103.  
  1104. #
  1105. #  create the list of parameters for chat'expect
  1106. #
  1107. #  ftp'expect(time_out, {value, return value});
  1108. #  the last response is stored in $ftp'response
  1109. #
  1110. sub ftp'expect
  1111. {
  1112.     local( $ret );
  1113.     local( $time_out );
  1114.     local( @expect_args );
  1115.     local( $code, $pre );
  1116.     
  1117.     $ftp'response = '';
  1118.     $ftp'fatalerror = 0;
  1119.  
  1120.     $time_out = shift( @_ );
  1121.     
  1122.     while( @_ ){
  1123.         $code = shift( @_ );
  1124.         $pre = '^';
  1125.         if( $code =~ /^\d+$/ ){
  1126.             $pre = "[.|\n]*^";
  1127.         }
  1128.         push( @expect_args, "$pre(" . $code . " .*)\\015\\n" );
  1129.         push( @expect_args, 
  1130.             "&expectgot( \$1, 0 ); " . shift( @_ ) );
  1131.     }
  1132.     
  1133.     # Treat all unrecognised lines as continuations
  1134.     push( @expect_args, "^(.*)\\015\\n" );
  1135.     push( @expect_args, "&expectgot( \$1, 0 ); 100" );
  1136.     
  1137.     # add patterns TIMEOUT and EOF
  1138.     
  1139.     push( @expect_args, 'TIMEOUT' );
  1140.     push( @expect_args, "&expectgot( 'timed out', 0 ); 0" );
  1141.     
  1142.     push( @expect_args, 'EOF' );
  1143.     push( @expect_args, "&expectgot( 'remote server gone away', 1 ); 99" );
  1144.     
  1145.     if( $ftp_show > 9 ){
  1146.         &printargs( $time_out, @expect_args );
  1147.     }
  1148.     
  1149.     $ret = &chat'expect( $time_out, @expect_args );
  1150.     if( $ret == 100 ){
  1151.         # we saw a continuation line, wait for the end
  1152.         push( @expect_args, "^.*\n" );
  1153.         push( @expect_args, "100" );
  1154.     
  1155.         while( $ret == 100 ){
  1156.             if( $ftp_show > 9 ){
  1157.                 &printargs( $time_out, @expect_args );
  1158.             }
  1159.             $ret = &chat'expect( $time_out, @expect_args );
  1160.         }
  1161.     }
  1162.  
  1163.     return $ret;
  1164. }
  1165.  
  1166.  
  1167. #
  1168. #  opens NS for io
  1169. #
  1170. sub ftp'open_data_socket
  1171. {
  1172.     local( $sockaddr, $port );
  1173.     local( $type, $myaddr, $a, $b, $c, $d );
  1174.     local( $mysockaddr, $family, $hi, $lo );
  1175.     
  1176.     $sockaddr = 'S n a4 x8';
  1177.  
  1178.     ($a,$b,$c,$d) = unpack( 'C4', $chat'thisaddr );
  1179.     $this = $chat'thisproc;
  1180.     
  1181.     socket( S, $pf_inet, $sock_stream, $tcp_proto ) || die "socket: $!";
  1182.     bind( S, $this ) || die "bind: $!";
  1183.     
  1184.     # get the port number
  1185.     $mysockaddr = getsockname( S );
  1186.     ($family, $port, $myaddr) = unpack( $sockaddr, $mysockaddr );
  1187.     
  1188.     $hi = ($port >> 8) & 0x00ff;
  1189.     $lo = $port & 0x00ff;
  1190.     
  1191.     #
  1192.     # we MUST do a listen before sending the port otherwise
  1193.     # the PORT may fail
  1194.     #
  1195.     listen( S, 5 ) || die "listen";
  1196.     
  1197.     &ftp'send( "PORT $a,$b,$c,$d,$hi,$lo" );
  1198.     
  1199.     return &ftp'expect($timeout,
  1200.         200, 1, # PORT command successful
  1201.         250, 1, # PORT command successful
  1202.  
  1203.         500, 0, # syntax error
  1204.         501, 0, # syntax error
  1205.         530, 0, # not logged in
  1206.  
  1207.         421, 0); # service unavailable, closing connection
  1208. }
  1209.     
  1210. sub ftp'close_data_socket
  1211. {
  1212.     close( NS );
  1213. }
  1214.  
  1215. sub ftp'send
  1216. {
  1217.     local( $send_cmd ) = @_;
  1218.  
  1219.     if( $send_cmd =~ /\n/ ){
  1220.         print $ftp'showfd "ERROR, \\n in send string for $send_cmd\n";
  1221.     }
  1222.     
  1223.     if( $ftp_show ){
  1224.         local( $sc ) = $send_cmd;
  1225.  
  1226.         if( $send_cmd =~ /^PASS/){
  1227.             $sc = "PASS <somestring>";
  1228.         }
  1229.         print $ftp'showfd "---> $sc\n";
  1230.     }
  1231.     
  1232.     &chat'print( "$send_cmd\r\n" );
  1233. }
  1234.  
  1235. sub ftp'printargs
  1236. {
  1237.     while( @_ ){
  1238.         print $ftp'showfd shift( @_ ) . "\n";
  1239.     }
  1240. }
  1241.  
  1242. sub ftp'filesize
  1243. {
  1244.     local( $fname ) = @_;
  1245.  
  1246.     if( ! -f $fname ){
  1247.         return -1;
  1248.     }
  1249.  
  1250.     return (stat( _ ))[ 7 ];
  1251.     
  1252. }
  1253.  
  1254. # make this package return true
  1255. 1;
  1256.